home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / FILES.SWG / 0033_General File Handler.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  5KB  |  159 lines
  1. {
  2. GUY MCLOUGHLIN
  3.  
  4.   ...Here's one way of creating generic routines to handle any type
  5.   of file...
  6. }
  7.  
  8. program Demo_Handle_Many_File_Types;
  9.  
  10. uses
  11.   crt;
  12.  
  13. type          (* Path string type definition.                         *)
  14.   st_79 = string[79];
  15.  
  16.               (* Enumerated type of the file types we want to handle. *)
  17.   FileType = (Fchar, FrecA, FrecB, Ftext, Funty);
  18.  
  19.               (* First record type definition.                        *)
  20.   recA = record
  21.            Name : string;
  22.            Age  : word
  23.          end;
  24.  
  25.               (* Second record type definition.                       *)
  26.   recB = record
  27.            Unit : word;
  28.            City : string
  29.          end;
  30.  
  31.               (* Case-varient multi-file type definition.             *)
  32.   rc_FileType = record
  33.                   case FT : FileType of
  34.                     Fchar : (Fchar1 : file of char);
  35.                     FrecA : (FrecA1 : file of recA);
  36.                     FrecB : (FrecB1 : file of recB);
  37.                     Ftext : (Ftext1 : text);
  38.                     Funty : (Funty1 : file)
  39.                   end;
  40.  
  41.  
  42.   (***** Display I/O error message.                                   *)
  43.   (*                                                                  *)
  44. procedure ErrorMessage({input }
  45.                           by_Error : byte;
  46.                           st_Path  : st_79);
  47. var
  48.   ch_Temp : char;
  49. begin
  50.             (* If an I/O error occured, then...                     *)
  51.   if (by_Error <> 0) then
  52.   begin
  53.     writeln;
  54.     case by_Error of
  55.         2 : writeln('File not found ---> ', st_Path);
  56.         3 : writeln('Path not found ---> ', st_Path);
  57.         4 : writeln('Too many files open');
  58.         5 : writeln('File access denied ---> ', st_Path);
  59.       100 : writeln('Disk read error');
  60.       103 : writeln('File not open ---> ', st_Path)
  61.           (* NOTE: The full error code listing code be            *)
  62.           (*       implemented if you like.                       *)
  63.     end;
  64.           (* Clear keyboard-buffer.                               *)
  65.     while keypressed do
  66.       ch_Temp := readkey;
  67.  
  68.           (* Pause for key-press.                                 *)
  69.     writeln('Press any key to continue');
  70.     repeat until keypressed
  71.   end
  72. end;        (* ErrorMessage.                                        *)
  73.  
  74. (***** Generic open routine to handle many different file types.    *)
  75. (*                                                                  *)
  76. procedure OpenFile({input } st_Path   : st_79;
  77.                             bo_Create : boolean;
  78.                         var rc_File   : rc_FileType);
  79. begin
  80.   {$I-}
  81.             (* Handle appropriate file type.                        *)
  82.   case rc_File.FT of
  83.     Fchar : begin
  84.               assign(rc_File.Fchar1, st_Path);
  85.               if bo_Create then
  86.                 rewrite(rc_File.Fchar1)
  87.               else
  88.                 reset(rc_File.Fchar1)
  89.             end;
  90.     FrecA : begin
  91.               assign(rc_File.FrecA1, st_Path);
  92.               if bo_Create then
  93.                 rewrite(rc_File.FrecA1)
  94.               else
  95.                 reset(rc_File.FrecA1)
  96.             end;
  97.     FrecB : begin
  98.               assign(rc_File.FrecB1, st_Path);
  99.               if bo_Create then
  100.                 rewrite(rc_File.FrecB1)
  101.               else
  102.                 reset(rc_File.FrecB1)
  103.             end;
  104.     Ftext : begin
  105.               assign(rc_File.Ftext1, st_Path);
  106.               if bo_Create then
  107.                 rewrite(rc_File.Ftext1)
  108.               else
  109.                 reset(rc_File.Ftext1)
  110.             end;
  111.     Funty : begin
  112.               assign(rc_File.Funty1, st_Path);
  113.               if bo_Create then
  114.                 rewrite(rc_File.Funty1, 1)
  115.               else
  116.                 reset(rc_File.Funty1, 1)
  117.             end
  118.   end;
  119.   {$I+}
  120.             (* Check for I/O error, and display message if needed.  *)
  121.   ErrorMessage(ioresult, st_Path)
  122.  
  123. end;        (* OpenFile.                                            *)
  124.  
  125.  
  126. var           (* Array of 5 mulit-file type records.                  *)
  127.   FileArray : array[1..5] of rc_FileType;
  128.  
  129.               (* Main program execution block.                        *)
  130. BEGIN
  131.               (* Clear the screen.                                    *)
  132.   clrscr;
  133.               (* Clear the multi-file type array.                     *)
  134.   fillchar(FileArray, sizeof(FileArray), 0);
  135.  
  136.               (* Initialize each file-variable to it's own type.      *)
  137.   FileArray[1].FT := Fchar;
  138.   FileArray[2].FT := FrecA;
  139.   FileArray[3].FT := FrecB;
  140.   FileArray[4].FT := Ftext;
  141.   FileArray[5].FT := Funty;
  142.  
  143.               (* Create a new file of type CHAR.                      *)
  144.   OpenFile('D:\TMP18\CHAR.TST', true,  FileArray[1]);
  145.  
  146.               (* Create a new file of type RecA.                      *)
  147.   OpenFile('D:\TMP18\RECA.TST', true,  FileArray[2]);
  148.  
  149.               (* Open an existing file of type RecB.                  *)
  150.   OpenFile('D:\TMP18\RECB.TST', false, FileArray[3]);
  151.  
  152.               (* Open an existing TEXT file.                          *)
  153.   OpenFile('D:\TMP18\TEXT.TST', false, FileArray[4]);
  154.  
  155.               (* Open an existing un-typed file.                      *)
  156.   OpenFile('D:\TMP18\BIN.DAT', false, FileArray[5]);
  157.  
  158. END.
  159.